home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / townsmsx / tif2scc.bas < prev    next >
BASIC Source File  |  1993-07-08  |  5KB  |  160 lines
  1. 1000 '   TIFF  -> msx screen12 scc 変換
  2. 1010 ' (C) Copy RIGHT BY    ちにゃと   NIFTY-Serve GFH01000
  3. 1020 CLEAR ,,,300000
  4. 1030 STOP OFF
  5. 1040 DEFSNG R,G,B
  6. 1050 DEFINT M,T,S,Y,J,K,I
  7. 1060 DIM MSX(27139)
  8. 1070 DIM TIF(256*212)
  9. 1080 *メイン
  10. 1090 SCREEN@ 0:CLS
  11. 1100 ON ERROR GOTO 0
  12. 1110 GOSUB *FILE_SLCT
  13. 1120 GOSUB *FILE_LOAD
  14. 1130 GOSUB *ERIA_SLCT
  15. 1140 GOSUB *CONVERT
  16. 1150 GOSUB *SAVE
  17. 1170 *JMP
  18. 1180 PRINT "続けますか？  (Y/N)"
  19. 1190 A$=INKEY$
  20. 1200 IF A$="y" OR A$="Y" THEN *メイン
  21. 1210 IF A$="N" OR A$="n" THEN END
  22. 1220 GOTO 1190
  23. 1230 *FILE_SLCT
  24. 1240 INPUT "ドライブは？ (A,B,D,Q)";A$
  25. 1250 IF A$<>"A" AND A$<>"B" AND A$<>"D" AND A$<>"Q" AND A$<>"a" AND A$<>"b" AND A$<>"d" AND A$<>"q" THEN 1240
  26. 1260 IF A$="a" OR A$="A" THEN DRV$="A:"
  27. 1270 IF A$="B" OR A$="b" THEN DRV$="B:"
  28. 1280 IF A$="D" OR A$="d" THEN DRV$="D:"
  29. 1290 IF A$="Q" OR A$="q" THEN DRV$="Q:"
  30. 1300 DIR$="":INPUT "ディレクトリを指定しますか(Y/N)";A$
  31. 1310 IF A$="Y" OR A$="y" THEN 1332
  32. 1320 IF A$="N" OR A$="n" THEN 1390
  33. 1330 IF A$="" THEN 1390
  34. 1332 ON ERROR GOTO *ERROR6
  35. 1334 FILES DRV$+DIR$
  36. 1335 ON ERROR GOTO 0
  37. 1340 INPUT "ディレクトリを指定してください(終了はリターン)";DIRNEW$
  38. 1350 IF DIRNEW$="" THEN 1390
  39. 1360 IF LEFT$(DIRNEW$,1)<>"\" THEN 1340
  40. 1365 DIR$=DIR$+DIRNEW$
  41. 1384 INPUT "さらにディレクトリを指定しますか(Y/N)";A$
  42. 1385 IF A$="Y" OR A$="y" THEN 1332
  43. 1386 IF A$="N" OR A$="n" THEN 1390
  44. 1388 GOTO 1384
  45. 1390 IF RIGHT$(DIR$,1)<>"\" THEN DIR$=DIR$+"\"
  46. 1392 ON ERROR GOTO *エラートラップ 
  47. 1395 PRINT DRV$+DIR$+"*.tif"
  48. 1400 PRINT "<*.tif>":FILES DRV$+DIR$+"*.tif"
  49. 1410 ON ERROR GOTO 0
  50. 1420 INPUT "ファイル名を入力してください";FIL$
  51. 1430 IF FIL$="" THEN RETURN *JMP
  52. 1440 DRVS$="":PRINT:INPUT "セーブするドライブを指定して下さい｡ (A/B/D)";A$
  53. 1450 IF A$="" THEN RETURN
  54. 1460 IF A$="A" OR A$="a" THEN DRVS$="A:"
  55. 1470 IF A$="B" OR A$="b" THEN DRVS$="B:"
  56. 1480 IF A$="D" OR A$="d" THEN DRVS$="D:"
  57. 1490 FIL=INSTR(FIL$,".")
  58. 1500 FILS$=LEFT$(FIL$,FIL-1)
  59. 1510 ON ERROR GOTO *ERROR3
  60. 1512 PRINT DRVS$+FILS$+".scc"
  61. 1520 FILES DRVS$+FILS$+".scc"
  62. 1525 ON ERROR GOTO 0
  63. 1530 INPUT "同名のＳＣＣファイルがあります。上書きしますか? (Y/N)";A$
  64. 1540 IF A$="Y" OR A$="y" THEN GOTO *DEL
  65. 1550 IF A$="n" OR A$="N" THEN RETURN *FILE_SLCT
  66. 1560 GOTO 1530
  67. 1570 RETURN
  68. 1580 *FILE_LOAD
  69. 1590 ON ERROR GOTO *エラートラップ2
  70. 1600 SCREEN@ 1,0
  71. 1605 PRINT DRV$+DIR$+FIL$
  72. 1610 LOAD@ DRV$+DIR$+FIL$
  73. 1620 ON ERROR GOTO 0
  74. 1630 RETURN
  75. 1640 *ERIA_SLCT
  76. 1650 X=0:Y=0
  77. 1660 *LINE_LOOP
  78. 1670 LINE (X,Y)-(X+255,Y+211),XOR,[255,255,255],B
  79. 1675 OX=X:OY=Y
  80. 1680 I$=INKEY$:IF I$="" THEN 1680
  81. 1690 IF I$=CHR$(&H1C) AND X<64 THEN X=X+1
  82. 1700 IF I$=CHR$(&H1D) AND X>0 THEN X=X-1
  83. 1710 IF I$=CHR$(&H1E) AND Y>0 THEN Y=Y-1
  84. 1720 IF I$=CHR$(&H1F) AND Y<28 THEN Y=Y+1
  85. 1730 IF I$=CHR$(&H0D) THEN *GET_TIF
  86. 1735 LINE (OX,OY)-(OX+255,OY+211),XOR,[255,255,255],B
  87. 1740 GOTO 1670
  88. 1750 *GET_TIF
  89. 1755 LINE (OX,OY)-(OX+255,OY+211),XOR,[255,255,255],B
  90. 1760 GET@A (X,Y)-(X+255,Y+211),TIF
  91. 1770 RETURN
  92. 1780 *CONVERT
  93. 1790 NX=256:NY=212
  94. 1800 FOR Y=0 TO NY-1
  95. 1820     FOR X=0 TO NX-1 STEP 4
  96. 1830         FOR I=0 TO 3
  97. 1840             TI=TIF(Y*NX+X+I)
  98. 1880             G(I)=TI \ 1024
  99. 1890             R(I)=(TI-G(I)*1024) \ 32
  100. 1900             B(I)=TI-G(I)*1024-R(I)*32
  101. 1905             Y(I)=INT((B(I)+1)/2)+INT((R(I)+1)/4)+INT((G(I)+1)/8)
  102. 1910         NEXT I
  103. 1920         G(4)=(G(0)+G(1)+G(2)+G(3)) \ 4
  104. 1922         R(4)=(R(0)+R(1)+R(2)+R(3)) \ 4
  105. 1923         B(4)=(B(0)+B(1)+B(2)+B(3)) \ 4
  106. 1925         YM=INT((B(4)+1)/2+(R(4)+1)/4+(G(4)+1)/8)
  107. 1950         JM=R(4)-YM:IF JM<0 THEN JM=64+JM
  108. 1960         KM=G(4)-YM:IF KM<0 THEN KM=64+KM
  109. 2120         II(0)=Y(0)*8+(KM AND &H7)
  110. 2130         II(1)=Y(1)*8+(KM \ 8)
  111. 2140         II(2)=Y(2)*8+(JM AND &H7)
  112. 2150         II(3)=Y(3)*8+(JM \ 8)
  113. 2160         AD&=VARPTR(MSX(X/2+3+Y*128))
  114. 2170         POKE AD&+1,II(0)
  115. 2180         POKE AD&+2,II(1)
  116. 2190         POKE AD&+3,II(2)
  117. 2200         POKE AD&+4,II(3)
  118. 2210     NEXT X
  119. 2220 NEXT Y
  120. 2240 RESTORE *DATA
  121. 2250 FOR I=0 TO 6
  122. 2260    READ A$
  123. 2270    POKE VARPTR(MSX(0))+I,VAL("&H"+A$)
  124. 2280 NEXT I
  125. 2290 RETURN
  126. 2300 *SAVE
  127. 2310 PRINT "コンバート終了しました。"
  128. 2320 *SAVEMAIN
  129. 2330 ON ERROR GOTO *ERROR4
  130. 2340 SAVE@ DRVS$+FILS$+".scc",MSX
  131. 2350 ON ERROR GOTO 0
  132. 2360 RETURN
  133. 2370 *ERROR3
  134. 2380 ON ERROR GOTO 0
  135. 2390 RESUME 1570 
  136. 2400 *DEL 
  137. 2410 ON ERROR GOTO 0:'*ERROR4
  138. 2420 KILL DRVS$+FILS$+".scc"
  139. 2430 ON ERROR GOTO 0
  140. 2440 RETURN
  141. 2450 *ERROR4
  142. 2460 PRINT "書き込めません。"
  143. 2470 RESUME *メイン
  144. 2480 *ERROR5
  145. 2490 PRINT "指定されたディレクトリがありません"
  146. 2500 RESUME 1340
  147. 2510 *ERROR6
  148. 2520 PRINT "ドライブの準備ができていません。"
  149. 2530 RESUME *FILE_SLCT
  150. 2610 *エラートラップ
  151. 2620 PRINT "ファイルがありません"
  152. 2630 RESUME *FILE_SLCT
  153. 2640 *エラートラップ2
  154. 2650 PRINT "ファイル名が間違っています。"
  155. 2660 RESUME *メイン
  156. 2680 *DATA
  157. 2690 ' SCC HEADER
  158. 2700 '    +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F
  159. 2710 DATA FE,00,00,00,D4,00,00
  160.